{-# LANGUAGE PatternGuards              #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Text.ZFormat.Base
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Base module - Doc type for formatting.
--
--------------------------------------------------------------------------------

module Text.ZFormat.Base
  (
    Doc
  , DocS

  , runDoc

  , null
  , empty

  , (<>)        -- re-export from Data.Monoid
  , (<+>)
  , ($+$)

  , char
  , text 
  , textS
  , blank

  , repeatChar

  , indent
  , underline

  , padL
  , padR
    
  ) where


import Data.Monoid

import Prelude hiding ( null )

-- | Doc is a Join List ...
--
data Doc = Nil  
         | Char   Char
         | Text   !Int  String
         | Join   Doc   Doc
         | Line
         | Indent Doc 
         | Underline


--
-- NOTE - Indent is left biased. We can\'t find the line length
-- of the last line by starting from the right, as we might have 
-- identation added from the left.
--

type DocS = Doc -> Doc

unDoc :: Doc -> ShowS
unDoc = fst . step 0 0 id
  where
   step _ w acc (Nil)        = (acc,w)
   step _ w acc (Char c)     = (acc . showChar c, w+1)
   step _ w acc (Text i ss)  = (acc . showString ss, w + i)
   step n w acc (Join a b)   = let (acc',w') = step n w acc a 
                               in step n w' acc' b
   step n _ acc (Line)       = (acc . showChar '\n' . indentS n, n)
   step _ w acc (Indent d)   = step w w acc d
   step _ w acc (Underline)  = (acc . showChar '\n' . underlS w, w)

   indentS :: Int -> ShowS
   indentS i | i < 1     = id
             | otherwise = showString $ replicate i ' '


   underlS :: Int -> ShowS
   underlS i | i < 1     = id
             | otherwise = showString $ replicate i '-'



runDoc :: Doc -> String
runDoc = ($ "") . unDoc


instance Show Doc where
  show = runDoc


instance Monoid Doc where
  mempty  = empty
  mappend = appendH 

-- | Length from the left, stops at a line break.
--
-- This gives the length of the first line.
--
lengthL :: Doc -> Int
lengthL = go
  where
    go (Nil)         = 0
    go (Char _)      = 1
    go (Text n _)    = n 
    go (Join Line _) = 0      -- stop
    go (Join a b)    = go a + go b
    go (Line)        = 0
    go (Indent a)    = go a 
    go (Underline)   = 0        -- underline is interpreted as Line


-- | Length from the right, stops at a line break.
--
-- This gives the length of just the document on the last line.
-- It is oblivious to indenting.
--
lengthR :: Doc -> Int
lengthR = either id id . go
  where
    go (Nil)              = Right 0 
    go (Char _)           = Right 1 
    go (Text n _)         = Right n
    go (Join _ Line)      = Left 0 
    go (Join _ Underline) = Left 0 
    go (Join a b)         = case go b of { Left i -> Left i
                                         ; Right i -> i `plus` go a}
    go (Line)             = Left 0
    go (Underline)        = Left 0
    go (Indent a)         = go a 

    plus i (Left n)    = Left (i+n)
    plus i (Right n)   = Right (i+n)

null :: Doc -> Bool
null Nil = True
null _   = False

empty :: Doc
empty = Nil 



appendH :: Doc -> Doc -> Doc
appendH Nil b   = b
appendH a   Nil = a
appendH a   b   = Join a b


infixr 6 <+>

(<+>) :: Doc -> Doc -> Doc
(<+>) a   b   = a <> Char ' ' <> b


infixr 5 $+$


($+$) :: Doc -> Doc -> Doc
($+$) Nil b   = b
($+$) a   Nil = a
($+$) a   b   = a <> Line <> b


char :: Char -> Doc
char = Char


text :: String -> Doc
text [] = Nil
text ss = Text (length ss) ss

textS :: ShowS -> Doc
textS f = text $ f []


repeatChar :: Int -> Char -> Doc
repeatChar i c | i <= 0    = Nil
               | otherwise = Text i (replicate i c)

-- | Construct a blank document.
-- 
-- This is not the same as the empty document:
-- 
-- > null blank == False
--
blank :: Doc
blank = Text 0 ""

-- | Horizontally indent a Doc.
--
-- Note - this space-prefixes the Doc on /the current line/. It
-- does not indent subsequent lines if the Doc spans multiple 
-- lines.
--
indent :: Int -> Doc -> Doc
indent i d | i < 1     = d
           | otherwise = repeatChar i ' ' <> Indent d


underline :: Doc -> Doc
underline Nil = Nil
underline d   = d <> Underline

padL :: Int -> Doc -> Doc
padL w d | n <- lengthL d 
         , w > n          = repeatChar (w - n) ' ' <> d
         | otherwise      = d


padR :: Int -> Doc -> Doc
padR w d | n <- lengthR d 
         , w > n          = d <> repeatChar (w - n) ' '
         | otherwise      = d


